home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / calc1 / calc.bas next >
BASIC Source File  |  1995-05-09  |  4KB  |  103 lines
  1.  
  2. '---------------------------------------------------------
  3. ' Handles alligning forms.  Forms all have a Gadet picturebox,
  4. ' around which a gap is left to draw a border to simulate
  5. ' a 3D control.  Each form is started in the top left corner,
  6. ' from which it can be moved by dragging.
  7. '---------------------------------------------------------
  8. '
  9. Sub AllignForm (Frm As Form)
  10.     Frm.Width = Frm.Gadget.Width + (2 * Outline)
  11.     Frm.Height = Frm.Gadget.Height + (2 * Outline)
  12.     Frm.Gadget.Move Outline, Outline
  13. End Sub
  14.  
  15. '---------------------------------------------------------
  16. ' This routine simulates the dragging behavior found in ProgMan.
  17. ' The built-in VB DragDrop routine does not handle clipping
  18. ' properly and yields poor visual results.
  19. '
  20. ' The routine:
  21. '   - Gets a handle to the screen (a DC of Null)
  22. '   - Creates a rectangular region based on the X,Y of the LCD
  23. '   - Sets the Clipping Region to that rectangle
  24. '   - Paints a box on the screen based on the mouse X,Y
  25. '     combined with the applets height and width.
  26. '   - Releases the Windows resources.
  27. '---------------------------------------------------------
  28. '
  29. Sub GhostForm (X As Integer, Y As Integer, H As Integer, W As Integer)
  30.     hScreen = GetDC(0)
  31.     hRegion = CreateRectRgn(RgnX1, RgnY1, RgnX2, RgnY2)
  32.     zot = SelectClipRgn(hScreen, hRegion)
  33.     hBrush = GetStockObject(NULL_BRUSH)
  34.     hObjOld = SelectObject(hScreen, hBrush)
  35.     zot = SetROP2(hScreen, R2_NOTXORPEN)
  36.     zot = Rectangle(hScreen, X, Y, H, W)
  37.     zot = DeleteObject(hRegion)
  38.     zot = UnrealizeObject(hScreen)
  39.     hScreen = ReleaseDC(0, hScreen)
  40. End Sub
  41.  
  42. Sub Main ()
  43.     Screen.MousePointer = 11
  44.     
  45.     TPRatio = Screen.TwipsPerPixelX
  46.     Bevel = 2 * TPRatio
  47.     Outline = Bevel + TPRatio
  48.  
  49.     Load Calculator
  50.  
  51.     ' Determine the screen bounding region
  52.     RgnX1 = Int(0) / TPRatio
  53.     RgnY1 = Int(0) / TPRatio
  54.     RgnX2 = Int(Screen.Width / TPRatio)
  55.     RgnY2 = Int(Screen.Height / TPRatio)
  56.     
  57.     q% = DoEvents()
  58.     Screen.MousePointer = 0
  59.  
  60.     Calculator.Show
  61.  
  62. End Sub
  63.  
  64. '---------------------------------------------------------
  65. ' This routine simulates a 3D form by drawing lines around
  66. ' a control where that control is positioned with a surrounding
  67. ' gap on the form itself.  The degree of the bevel can be
  68. ' changed in the WH_MAIN FormLoad routine, and is based on
  69. ' a pixel measurement.
  70. '---------------------------------------------------------
  71. '
  72. Sub Make3DForm (TheForm As Form, Ctrl As Control)
  73.     
  74.     L% = Ctrl.Left
  75.     R% = Ctrl.Left + Ctrl.Width
  76.     T% = Ctrl.Top
  77.     B% = Ctrl.Top + Ctrl.Height
  78.     
  79.     TheForm.Line (L% - Bevel, T% - Bevel)-(R% + Bevel, T%), QBColor(15), BF
  80.     TheForm.Line (L% - Bevel, T%)-(L%, B%), QBColor(15), BF
  81.     TheForm.Line (L% - Bevel, B%)-(R% + Bevel, B% + Bevel), QBColor(8), BF
  82.     TheForm.Line (R%, B%)-(R% + Bevel, T%), QBColor(8), BF
  83.     TheForm.Line (L% - Outline, T% - Outline)-(R% + Outline - TPRatio, B% + Outline - TPRatio), QBColor(0), B
  84.     
  85. End Sub
  86.  
  87. Sub ShadeControl (TheControl As Control, ThePic As Control)
  88.     ThePic.ScaleMode = 3    ' Pixel
  89.     ThePic.ScaleHeight = 8
  90.     ThePic.ScaleWidth = 8
  91.     hBrush = CreatePatternBrush(ThePic.Picture)
  92.     TheControl.ScaleMode = 3    'Pixel
  93.     Dim FillArea As RECT
  94.     FillArea.Left = 0
  95.     FillArea.Top = 0
  96.     FillArea.right = TheControl.ScaleWidth
  97.     FillArea.bottom = TheControl.ScaleHeight
  98.     Success% = FillRect(TheControl.hDC, FillArea, hBrush)
  99.     Success% = DeleteObject(hBrush)
  100.     TheControl.ScaleMode = 1
  101. End Sub
  102.  
  103.